; -*-Scheme-*-

;************************************************************************/
;*                                                                      */
;* Copyright (c) 2003-2009 Vladimir Tsichevski <tsichevski@gmail.com>   */
;*                                                                      */
;* This file is part of bigloo-lib (http://bigloo-lib.sourceforge.net)  */
;*                                                                      */
;* This library is free software; you can redistribute it and/or        */
;* modify it under the terms of the GNU Lesser General Public           */
;* License as published by the Free Software Foundation; either         */
;* version 2 of the License, or (at your option) any later version.     */
;*                                                                      */
;* This library is distributed in the hope that it will be useful,      */
;* but WITHOUT ANY WARRANTY; without even the implied warranty of       */
;* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU    */
;* Lesser General Public License for more details.                      */
;*                                                                      */
;* You should have received a copy of the GNU Lesser General Public     */
;* License along with this library; if not, write to the Free Software  */
;* Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307 */
;* USA                                                                  */
;*                                                                      */
;************************************************************************/

(module history
	(extern
	 (include "readline/history.h")
	 )
	(include "common.sch")
	(import
	 os
	 ;;srfi-1
	 misc
	 )
	(export
	 (history-list::pair-nil)
	 (history-arg-extract s::string #!optional first last)
	 (history-get-event s::string delimiting-quote::char)
	 (history-tokenize::pair-nil s::string)
	 (history-remove which::int)
	 (history-replace which::int line::string data::obj)
	 (history-unstifle)
	 (history-current)
	 (history-get offset::int)
	 (previous-history)
	 (next-history)
	 (history-search string::string #!optional backward?)
	 (history-read #!optional filename from to)
	 (history-write #!optional filename from to)
	 (history-append nelements::int filename::string)
	 (history-truncate-file filename::string lines::int)
	 (history-expand s::string)
	 )
	)

;; The structure used to store a history entry. 
(define-object HIST_ENTRY ()
  (fields
   (string line)
   (obj data)
   ))


;; A structure used to pass the current state of the history stuff around. 
(define-object HISTORY_STATE ()
  (fields
;;   HIST_ENTRY **entries;		;; Pointer to the entries themselves. 
;;   int offset;			;; The location pointer within this array. 
;;   int length;			;; Number of elements within this array. 
;;   int size;			;; Number of slots allocated to this array. 
;;   int flags
   ))

;; Initialization and state management. 

(define-func (history-init using_history)  void ())

(define-func history_get_history_state HISTORY_STATE ())

(define-func history_set_history_state void ((HISTORY_STATE state)))

;; Manage the history list. 

(define-func (history-add add_history) void ((string entry)))

;; Convenience macros to write procedures returning entry
;; information. Returns entry string and data as scheme values. The
;; entry itself is destroyed
(define-macro (split-entry . args)
  `(let((entry::hist-entry
	 (pragma::hist-entry ,@args)))
     (and (pragma::bool "$1 != NULL" entry)
	  (let((s::string(hist-entry-line entry))
	       (o(pragma::obj "(obj_t)$1->data" entry)))
	    (if (pragma::bool "$1 == NULL" o)
		(set! o #f)
		(object-unref o))
	    (pragma "free($1)"entry)
	    (values s o)))))

(define (history-remove which::int)
  (split-entry "remove_history($1)"which))

(define (history-replace which::int line::string obj)
  (object-ref obj)
  (split-entry "replace_history_entry($1, $2, $3)"
	       which line obj))

;; TODO: if we set the data part of any history entry, we should
;; unreference all that objects prior the call of history-clear
(define-func (history-clear clear_history) void ())

(define-func (history-stifle stifle_history) void ((int preserve)))

(define (history-unstifle)
  (let((result(pragma::int "unstifle_history()")))
    (and(>=fx result 0)result)))

(define-func (history-stifled? history_is_stifled) bool ())

;; Information about the history list. 

(define (history-list::pair-nil)
  (let((clist(pragma::void* "history_list()")))
    (if (pragma::bool "$1 != NULL" clist)
	(let loop ((accu '()) (i 0))
	  (let ((p::hist-entry
		 (pragma::hist-entry
		  "((HIST_ENTRY**)$1)[$2]" clist i)))
            (if (pragma::bool #"$1 == NULL" p)
                (reverse accu)
                (loop (cons
		       (cons (pragma::string "$1->line" p)
			     (and (pragma::bool "$1->data != NULL" p)
				  (pragma::obj "$1->data" p)))
		       accu) (+fx i 1)))))
	'())))

(define-func (history-where where_history) int ())

(define (history-current)
  (split-entry "current_history()"))

(define (history-get offset::int)
  (split-entry "history_get($1)" offset))

;; Return the number of bytes that the primary history entries are using.
;;    This just adds up the lengths of the_history->lines. 
;; extern int history_total_bytes __P((void))

;; Moving around the history list. 

(define-func (history-set-pos! history_set_pos) bool ((int which)))

(define (previous-history)
  (split-entry "previous_history()"))

(define (next-history)
  (split-entry "next_history()"))

;; Searching the history list. 

(define (history-search string::string #!optional backward?)
  (let*((direction::int(if backward? -1 1))
	(found(pragma::int "history_search($1, $2)" string direction)))
    (and(>=fx found 0)found)))

(define (history-search-prefix string::string #!optional backward?)
  (let*((direction::int(if backward? -1 1))
	(found(pragma::int "history_search_prefix($1, $2)" string direction)))
    (and(>=fx found 0)found)))

(define (history-search-pos string::string #!optional backward? pos)
  (let*((direction::int(if backward? -1 1))
	(pos::int (or pos (history-current)))
	(found(pragma::int "history_search_pos($1, $2, $3)" string direction pos)))
    (and(>=fx found 0)found)))

;; Managing the history file. 

(define (history-read #!optional filename from to)
  (let((filename::string (or filename (pragma::string "NULL")))
       (from::int (or from 0))
       (to::int (or to -1)))
    
    (when (pragma::bool "read_history_range($1, $2, $3)" filename from to)
	  (cerror "history-read" filename from to))))

(define (history-write #!optional filename from to)
  (let((filename::string (or filename (pragma::string "NULL"))))    
    (when (pragma::bool "write_history($1)" filename)
	  (cerror "history-write" filename from to))))

(define (history-append nelements::int filename::string)
  (when (pragma::bool "append_history($1, $2)" nelements filename)
	(cerror "history-append" nelements filename)))

(define (history-truncate-file filename::string lines::int)
  (when (pragma::bool "history_truncate_file($1, $2)" filename lines)
	(cerror "history-truncate-file" filename lines)))

;; History expansion. 

(define (history-expand s::string)
  (let*((resultp::string (pragma::string "NULL"))
	(result::int
	 (pragma::int "history_expand($1, &$2)" s resultp))
	(result-string::bstring resultp))
    (pragma "free($1)"resultp)
	
    (case result
      ((0) #f)
      ((1) result-string)
      ((-1)(error "history-expand" result-string s))
      ((2) (list result-string)))))

(define (history-arg-extract s::string #!optional first last)
  (let*((first::int (or first 0))
	(last::int (or last (pragma::int "'$'")))
	(result::string
	 (pragma::string "history_arg_extract($1, $2, $3)"
			 first last s)))
    (and(pragma::bool "$1 != NULL" result)
	result)))

;; Return the text of the history event beginning at the current
;;    offset into STRING.  Pass STRING with *INDEX equal to the
;;    history_expansion_char that begins this specification.
;;    DELIMITING_QUOTE is a character that is allowed to end the string
;;    specification for what to search for in addition to the normal
;;    characters `:', ` ', `\t', `\n', and sometimes `?'. 
(define (history-get-event s::string delimiting-quote::char)
  (let*((caller-index::int (pragma::int "0"))
	(event
	 (pragma::string
	  "get_history_event($1, &$2, $3)"
	  s caller-index delimiting-quote)))
    (values event caller-index)))

(define (history-tokenize::pair-nil s::string)
  (string*->string-list(pragma::string* "history_tokenize($1)" s)))

;; Exported history variables. 
(define-global history_base int)

@if #f

;; Used to split words by history_tokenize
(define-global history_word_delimiters string)

@endif

;; extern int history_length
;; extern int max_input_history
;; extern char history_expansion_char
;; extern char history_subst_char
;; extern char history_comment_char
;; extern char *history_no_expand_chars
;; extern char *history_search_delimiter_chars
;; extern int history_quotes_inhibit_expansion
;; 
;; If set, this function is called to decide whether or not a particular
;;    history expansion should be treated as a special case for the calling
;;    application and not expanded. 
;; extern Function *history_inhibit_expansion_function
;; 
